home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Tools / Alpha 6.51b13 ƒ / Tcl / Menus / filesetsMenu.tcl < prev    next >
Text File  |  1997-04-23  |  43KB  |  1,538 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "filesets.tcl"
  6.  #                                      created: 20/7/96 {6:22:25 pm} 
  7.  #                                  last update: 6/4/97 {11:16:07 am} 
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #==============================================================================
  15.  # Alpha calls two fileset-related routines, 'getCurrFileSet', and 
  16.  # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
  17.  # on occasion, but this isn't critical.
  18.  #==============================================================================
  19.  # 
  20.  #  modified by  rev reason
  21.  #  -------- --- --- -----------
  22.  #  24/3/96  VMD 1.0 update of Pete's original to allow mode-specific filesets
  23.  #  27/3/96  VMD 1.1 added hierarchial filesets, and checks for unique menus
  24.  #  13/6/96  VMD 1.2 memory efficiency improvements with 'fileSets' array
  25.  #  10/3/97  VMD 1.3 added 'procedural' fsets, including 'Open Windows'
  26.  #  6/4/97   VMD 1.31 various fixes incorporated - thanks!
  27.  # ###################################################################
  28.  ##
  29.  
  30. ## 
  31.  # These procedures    are    now    more robust    and    general-purpose. Basic new
  32.  # features    are: 
  33.  # 
  34.  #       *  user configurable    menu
  35.  #       *  unique-menu names    are    ensured, so    there can be no    clashes
  36.  #       *  new fileset types    ('tex' and 'fromHierarchy')
  37.  #       *  new utility functions    ('stuff', 'wordCount',...)
  38.  #       *  filesets need    not    appear in the menu;    in fact    they can be
  39.  #          anywhere you like
  40.  ##
  41.  
  42. if $startingUp {
  43.     addMenu fsetMenuName
  44.     set fsetMenuName     "•131"
  45.     return
  46. }
  47.  
  48. ## 
  49.  # -------------------------------------------------------------------------
  50.  #     
  51.  # "gCheckset" --
  52.  #    
  53.  #    If the global variable 'var' isn't yet defined,    it is set to the
  54.  #    value 'val'.  Else nothing happens.
  55.  #           
  56.  # -------------------------------------------------------------------------
  57.  ##
  58. proc gCheckset {v val} {
  59.     upvar \#0 $v var
  60.     if [info exists var] { return [set var] }
  61.     return [set var $val]
  62. }
  63.  
  64. proc fsetMenuName {} {}
  65. # Build some filesets on the fly.
  66. catch {unset fileSets}
  67. catch {unset currFileSet}
  68. set gfileSets(Help) "$HOME:Help:*"
  69. set gfileSets(System) "$HOME:Tcl:SystemCode:*.tcl"
  70. set gfileSets(Menus) "$HOME:Tcl:Menus:*.tcl"
  71. set gfileSets(Modes) "$HOME:Tcl:Modes:*.tcl"
  72. set "gfileSets(Open Windows)" procFilesetOpenWindows 
  73. set gfileSetsType(Help) "fromDirectory"
  74. set gfileSetsType(System) "fromDirectory"
  75. set gfileSetsType(Menus) "fromDirectory"
  76. set gfileSetsType(Modes) "fromDirectory"
  77. set "gfileSetsType(Open Windows)" "procedural"
  78.  
  79. proc procFilesetOpenWindows {} { return [winNames -f] }
  80.  
  81. if !$alphaLite { 
  82.     set gfileSets(User) "$HOME:Tcl:UserCode:*.tcl"
  83.     set gfileSetsType(User) "fromDirectory"
  84. }
  85.  
  86. # Default curr fileset is the first one. Can be changed in 'prefs.tcl'.
  87. set currFileSet [lindex [array names gfileSets] 0]
  88.  
  89. #################################################
  90. #                                                #
  91. #    Section    1:    Fileset    variables and flags.    #
  92. #                                                #
  93. #################################################
  94. # Any of these can be over-ridden by the stored #
  95. # definitions in defs.tcl, arrdefs.tcl          #
  96. #################################################
  97.  
  98. ## 
  99.  # We don't    show the 'help'    fileset, since it's    under the MacOS
  100.  # AppleGuide menu.     Also we could perhaps yank    tex-filesets away
  101.  # into    their own menu,    in which case the tex-system could add to
  102.  # this    variable as    it went    along.
  103.  ##
  104. gCheckset filesetsNotInMenu { "Help" "Open Windows" }
  105.  
  106. ## 
  107.  # A type is a means of    generating a fileset given its 
  108.  # description in the variable 'gfileSets(name)':
  109.  ##
  110. gCheckset fileSetsTypes { "list" "glob" "fromHierarchy" "procedural" }
  111.  
  112. ## 
  113.  # A menu type is a    means of prompting the user    and    
  114.  # characterising the interface    to a type, even
  115.  # though the actual storage may be    very simple
  116.  # (a list in most cases).
  117.  ##
  118. set fileSetsTypesThing(fromDirectory) "glob"
  119. set fileSetsTypesThing(fromHierarchy) "fromHierarchy"
  120. set fileSetsTypesThing(think) "list"
  121. set fileSetsTypesThing(codewarrior) "list"
  122. set fileSetsTypesThing(ftp) "list"
  123. set fileSetsTypesThing(fromOpenWindows) "list"
  124. set fileSetsTypesThing(procedural) "procedural"
  125.  
  126. ## 
  127.  # To add a    new    fileset    type, you need to define the following:
  128.  #       set fileSetsTypesThing(myType) "list"
  129.  #       proc    myTypeCreateFileset    {} {}
  130.  #       proc    myTypeFilesetUpdate    {name} {}
  131.  # 
  132.  # For more    complex    types (e.g.    the    tex-type), define as follows:
  133.  #       set fileSetsTypesThing(myType) "myType"
  134.  #       proc    myTypeCreateFileset    {} {}
  135.  #       proc    myTypeFilesetSelected {    fset menu item }    {}
  136.  #       proc    myTypeFilesetUpdate    { name } {}
  137.  #       proc    myTypeListFilesInFileset { name    } {}
  138.  #       proc    myTypeMakeFileSetSubMenu { name    } {}
  139.  # 
  140.  # These procedures    will all be    called automatically under the
  141.  # correct circumstances.  The purposes of these are as follows:
  142.  #
  143.  #   'create'   -- query the user for name etc. and create
  144.  #   'update'   -- given the information in 'gfileSets', recalculate
  145.  #                   the member files.
  146.  #   'selected' -- a member was selected in a menu.
  147.  #   'list'     -- given info in all except 'fileSets', return list
  148.  #                 of files to be stored in that variable.
  149.  #   'submenu'  -- generate the sub-menu
  150.  # 
  151.  # Your    code may wish to call 'isWindowInFileset ?win? ?type?' to
  152.  # check if    a given    (current by    default) window    is in a    fileset    of
  153.  # a given type.
  154.  ##
  155.  
  156. ## 
  157.  # -------------------------------------------------------------------------
  158.  #     
  159.  #    "filesetSortOrder" --
  160.  #    
  161.  #       The structure of    this variable dictates how the fileset
  162.  #       menu    is structured:
  163.  #           
  164.  #           '{pattern p}' 
  165.  #               lists all filesets which    match 'p'
  166.  #           '-' 
  167.  #               adds    a separator    line
  168.  #           '{list of types}' 
  169.  #               lists all filesets of those types.
  170.  #           '{submenu name sub-order-list}' 
  171.  #               adds    a submenu with name    'name' and recursively
  172.  #               adds    filesets to    that submenu as    given by the 
  173.  #               sub-order.
  174.  #               
  175.  #       Leading,    trailing and double    separators are automatically
  176.  #       removed.
  177.  #     
  178.  # -------------------------------------------------------------------------
  179.  ##
  180. gCheckset filesetSortOrder { {pattern System} {pattern Menus} {pattern Modes} {pattern User} {pattern Preferences} \
  181.     - {tex} - {pattern *.cc} {submenu Headers {pattern *.h}} \
  182.     - {fromDirectory think codewarrior ftp \
  183.     fromOpenWindows fromHierarchy} * } 
  184.                         
  185. set    "filesetUtils(browseFileset…)" [list * browseFileset]
  186. set    "filesetUtils(renameFileset…)" [list * renameFileset]
  187. set    "filesetUtils(openEntireFileset…)" [list * openEntireFileset]
  188. set    "filesetUtils(filesetToAlpha…)" [list * filesetToAlpha]
  189. set    "filesetUtils(closeEntireFileset…)" [list * closeEntireFileset]
  190. set    "filesetUtils(replaceInFileset…)" [list * replaceInFileset]
  191. set    "filesetUtils(stuffFileset…)" [list * stuffFileset]
  192. set    "filesetUtils(wordCount)" [list * wordCountFileset]
  193. set    "filesetUtils(wordCountFast)" [list * wordCountFilesetFast]
  194. set    "filesetUtils(openFilesetFolder…)" [list * openFilesetFolder]
  195.  
  196.  
  197. ## 
  198.  # The meaning of these    flags is as    follows:
  199.  #       sortFilesetItems    -- 
  200.  #           a type can have the option of being unsorted    (e.g. tex-filesets)
  201.  #       indentFilesetItems --
  202.  #           visual formatting may be    of relevance to    some types
  203.  #       sortFilesetsByType -- 
  204.  #           use the variable    'filesetSortOrder' to determine    the
  205.  #           visual structure    of the fileset menu
  206.  #       autoAdjustFileset --
  207.  #           when    a file is selected from    the    menu, do we    try    and    
  208.  #           keep    'currFileSet' accurate?
  209.  #       includeNonTextFiles --
  210.  #           filesets may include non-text files.  Alpha will tell the
  211.  #           finder to open these if they are selected.
  212.  ##        
  213. foreach    flag { sortFilesetItems    indentFilesetItems sortFilesetsByType \
  214.                autoAdjustFileset includeNonTextFiles } {
  215.     gCheckset filesetFlags($flag) 0
  216. }
  217. unset flag
  218. set filesetFlagsRebuild(sortFilesetsByType) "*"
  219. set filesetFlagsRebuild(includeNonTextFiles) "*"
  220.  
  221. # To add a new fileset type, all we have to do is this:
  222. set fileSetsTypesThing(tex) "tex"
  223. lappend fileSetsTypes "tex"
  224. # If you create new types just add lines like that to
  225. # your "prefs.tcl", or install them permanently using
  226. # addDef and addArrDef.
  227.  
  228. #===========================================================================
  229. # The support routines.
  230. #===========================================================================
  231. # Called from Alpha to get list of files for current file set.
  232. proc getCurrFileSet {} {
  233.     global currFileSet
  234.     return [getFileSet $currFileSet]
  235. }
  236.  
  237. # Called from Alpha to get names. The first name returned is taken to 
  238. # be the current fileset.
  239. proc getFileSetNames {} {
  240.     global gfileSets currFileSet
  241.     set ind [lsearch [array names gfileSets] $currFileSet]
  242.     if {$ind < 0} {set ind 0}
  243.     return [linsert [lsort [lreplace [array names gfileSets] $ind $ind]] 0 $currFileSet]
  244. }
  245.  
  246.  
  247. # Keep 'sets' menu up to date.
  248. trace vdelete currFileSet w shadowCurrFileSet
  249. trace variable currFileSet w shadowCurrFileSet
  250. proc shadowCurrFileSet {nm1 nm2 op} {
  251.     global gfileSets currFileSet
  252.     foreach name [array names gfileSets] {
  253.         if {$name == $currFileSet} {
  254.             catch {markMenuItem -m choose $name on}
  255.         } else {
  256.             catch {markMenuItem -m choose $name off}
  257.         }
  258.     }
  259.     return $currFileSet
  260. }
  261.  
  262.  
  263. #================================================================================
  264. # Edit a file from a fileset via list dialogs (no mousing around).
  265. #================================================================================
  266. proc editFile {} {
  267.     global currFileSet modifiedVars gfileSetsType
  268.     
  269.     set fset [pickFileset "" {Fileset?} "list" [list {*recent*}]]
  270.     set currFileSet $fset
  271.     lappend modifiedVars currFileSet
  272.     
  273.     if {$fset == {*recent*}} {return [editRecentFile]}
  274.     set ff [getFilesInSet $fset]
  275.     foreach f $ff {
  276.         lappend disp [file tail $f]
  277.     }
  278.     foreach res [listpick -l -p {File?} [lsort -ignore $disp]]  {
  279.         set ind [lsearch $ff \*:$res]
  280.         if {$gfileSetsType($fset) == "ftp"} {
  281.             ftpFilesetOpen $fset [lindex $ff $ind]
  282.         } else {
  283.             catch {generalOpenFile [lindex $ff $ind]}
  284.         }
  285.     }
  286. }
  287.  
  288. # We only return TEXT files, since we don't want Alpha
  289. # manipulating the data fork of non-text files.
  290. proc getFileSet {fset} {
  291.     global filesetFlags
  292.     if $filesetFlags(includeNonTextFiles) {
  293.         set fnames ""
  294.         foreach f [getFilesInSet $fset] {
  295.             if [file isfile $f] {
  296.                 getFileInfo $f a
  297.                 if {$a(type) == "TEXT"} {
  298.                     lappend fnames $f
  299.                 }
  300.             }
  301.         }
  302.         return $fnames
  303.     } else {
  304.         return [getFilesInSet $fset]
  305.     }
  306. }
  307.  
  308. proc browseFileset {{fset ""}} {
  309.     global tileLeft tileTop tileWidth errorHeight
  310.  
  311.     set fset [pickFileset $fset {Fileset?}]
  312.  
  313.     foreach f [getFilesInSet $fset] {
  314.         append text "\t[file tail $f]\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  315.     }
  316.     new -n "* FileSet '$fset' Browser *" -g $tileLeft $tileTop 200 $errorHeight
  317.     global winModes
  318.     set name [lindex [winNames] 0]
  319.     changeMode [set winModes($name) Brws]
  320.  
  321.     insertText "(<cr> to go to file)\r-----\r$text\r"
  322.     goto 0
  323.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  324.     setWinInfo dirty 0
  325.     setWinInfo read-only 1
  326.     message ""
  327. }    
  328.  
  329. ############################################
  330. #                                           #
  331. #    Section    2:    Basic fileset procedures   #
  332. #                                           #
  333. ############################################
  334.  
  335. proc newFileset {} {
  336.     global currFileSet gfileSetsType fileSetsTypesThing
  337.     set type [eval [list prompt "New fileset type?" \
  338.                 "fromDirectory" "Type:"] [lsort -ignore [array names fileSetsTypesThing]]]
  339.     set name [eval ${type}CreateFileset]
  340.  
  341.     if ![string length $name] return
  342.     
  343.     addArrDef gfileSetsType $name $type
  344.     set gfileSetsType($name) $type
  345.  
  346.     set currFileSet $name
  347.     filesetsJustChanged $type $name
  348.     return $currFileSet
  349. }
  350.  
  351. ## 
  352.  # -------------------------------------------------------------------------
  353.  # 
  354.  # "filesetsJustChanged" --
  355.  # 
  356.  #  If we've added, deleted, modified a fileset, we call this procedure.
  357.  #  In most cases we must rebuild everything (due to limitations in Alpha),
  358.  #  but for 'procedural' filesets, we can just do the utilities menu.
  359.  # -------------------------------------------------------------------------
  360.  ##
  361. proc filesetsJustChanged {type name} {
  362.     if {$type == "procedural"} {
  363.         global filesetsNotInMenu modifiedVars
  364.         if {[lsearch $filesetsNotInMenu $name] == -1} {
  365.             lappend filesetsNotInMenu $name
  366.             lappend modifiedVars filesetsNotInMenu
  367.         }
  368.         rebuildFilesetUtilsMenu
  369.     } else {
  370.         rebuildAllFilesets
  371.     }
  372. }
  373.  
  374. proc deleteFileset { {fset ""} {yes 0} } {
  375.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  376.     global fsetMenuName subMenuFilesetInfo subMenuInfo filesetsNotInMenu
  377.     global modifiedVars
  378.     
  379.     set fset [pickFileset $fset "Delete which Fileset?"]
  380.      if {$currFileSet == $fset} {catch {set currFileSet System}}
  381.  
  382.     if {$yes || [askyesno "Delete fileset \"$fset\"?"] == "yes"} {
  383.         catch {unset "fileSetsExtra($fset)"}
  384.         catch {unset "gfileSetsType($fset)"}
  385.         catch {unset "fileSets($fset)"}
  386.         catch {unset "gfileSets($fset)"}
  387.         
  388.         removeArrDef gfileSetsType $fset
  389.         catch {removeArrDef fileSetsExtra $fset}
  390.         removeArrDef gfileSets $fset
  391.  
  392.         # find its menu:
  393.         set base ""
  394.         if [info exists subMenuFilesetInfo($fset)] {
  395.             foreach m $subMenuFilesetInfo($fset) {
  396.                 # remove info about it's name
  397.                 catch {unset subMenuInfo($m)}
  398.                 catch {removeMenu $m}
  399.                 # try and remove it's base from the main menu too
  400.                 if { [string trimright $m] == $fset } { set base $m }
  401.             }
  402.             unset subMenuFilesetInfo($fset)
  403.         }
  404.         
  405.         if {[set l [lsearch  $filesetsNotInMenu $fset]] != -1} {
  406.             set filesetsNotInMenu [lreplace $filesetsNotInMenu $l $l]
  407.             lappend modifiedVars filesetsNotInMenu
  408.             deleteMenuItem -m choose $fset
  409.             deleteMenuItem -m hideFileset $fset
  410.             return
  411.         }
  412.         if [catch {deleteMenuItem -m $fsetMenuName $base}] {
  413.             # it's on a submenu or somewhere else so we just have
  414.             # to do the lot!
  415.             if !$yes { rebuildAllFilesets }
  416.         } else {
  417.             deleteMenuItem -m choose $fset
  418.             deleteMenuItem -m hideFileset $fset
  419.         }
  420.     }
  421. }
  422.  
  423. ## 
  424.  # -------------------------------------------------------------------------
  425.  #     
  426.  #    "pickFileset" --
  427.  #    
  428.  #     Ask the user for a/several    filesets.  If 'fset' is    set, we    just
  429.  #     return    that (this avoids 'if {$fset !=    ""}    { set fset [pick...] }
  430.  #     constructs    everywhere).  A    prompt can be given, and a dialog type
  431.  #     (either a listpick, a pop-up menu,    or a listpick with multiple
  432.  #     selection), and extra items can be    added to the list if desired.
  433.  # -------------------------------------------------------------------------
  434.  ##
  435. proc pickFileset { fset {prompt Fileset?} {type "list"} {extras {}} } {
  436.     global gfileSets currFileSet
  437.     if { $fset != "" } { return $fset }
  438.     switch $type {
  439.         "popup" {
  440.             set fset [eval [list prompt $prompt \
  441.                 $currFileSet "FileSet:"] [lsort -ignore [array names gfileSets]]]
  442.             if ![info exists gfileSets($fset)] { error "No such fileset" }
  443.             return $fset
  444.         }
  445.         "list" {
  446.             return [listpick -p $prompt -L $currFileSet \
  447.                 [lsort -ignore [concat $extras [array names gfileSets]]]]
  448.         }
  449.         "multilist" {
  450.             return [listpick -p $prompt -l -L $currFileSet \
  451.                 [lsort -ignore [concat $extras [array names gfileSets]]]]
  452.         }        
  453.     }
  454. }
  455.  
  456. proc renameFileset {} {
  457.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  458.     global fileSetsTypesThing
  459.     
  460.     set fset [pickFileset "" {Fileset to rename?}]
  461.      
  462.     set name [getline "Rename to:" $fset]
  463.     if {![string length $name] || $name == $fset} return
  464.  
  465.     set gfileSets($name) $gfileSets($fset)
  466.     set gfileSetsType($name) $gfileSetsType($fset)
  467.     catch {set fileSets($name) $fileSets($fset)}
  468.     catch {set fileSetsExtra($name) $fileSetsExtra($fset)}
  469.  
  470.     deleteFileset $fset 1
  471.     
  472.     addArrDef gfileSets $name $gfileSets($name)
  473.     addArrDef gfileSetsType $name $gfileSetsType($name)
  474.     catch {addArrDef fileSetsExtra $name $fileSetsExtra($name)}
  475.     
  476.     filesetsJustChanged $gfileSetsType($name) $name
  477.     set currFileSet $name
  478. }
  479.  
  480. proc updateCurrentFileset {} {
  481.     global currFileSet gfileSetsType
  482.     set type $gfileSetsType($currFileSet)
  483.     catch {eval "${type}FilesetUpdate" \{$currFileSet\} }
  484.     eval [makeFileSetAndMenu $currFileSet 1]
  485.     
  486.     callFilesetUpdateProcedures $currFileSet
  487. }
  488.  
  489. proc callFilesetUpdateProcedures { {fset ""} } {
  490.     global filesetUpdateProcs gfileSetsType
  491.     if { $fset == "" } {
  492.         set types [array names filesetUpdateProcs]
  493.     } else {
  494.         set types $gfileSetsType($fset)
  495.     }
  496.     
  497.     foreach l $types {
  498.         if [info exists filesetUpdateProcs($l)] {
  499.             foreach proc $filesetUpdateProcs($l) {
  500.                 eval $proc
  501.             }
  502.         }
  503.     }
  504.     
  505. }
  506.  
  507. proc listContains { list item } { return [expr [lsearch -exact $list $item] != -1] }
  508.  
  509.  
  510. ##################################################
  511. #                                                 #
  512. #    Section    3: Creation    of basic fileset types     #
  513. #                                                 #
  514. ##################################################
  515.  
  516. proc proceduralCreateFileset {} {
  517.     global gfileSets gfileSetsType filesetsNotInMenu modifiedVars
  518.     set name [getline "Name for this fileset…"]
  519.     if {![string length $name]} return
  520.     set gfileSetsType($name) "procedural"
  521.     set p procFileset[join $name ""]
  522.     set gfileSets($name) $p
  523.     addUserLine "\# procedure to list files in fileset '$name' on the fly"
  524.     addUserLine "proc $p \{\} \{"
  525.     addUserLine "\t"
  526.     addUserLine "\}"
  527.     addArrDef gfileSets $name $gfileSets($name)
  528.     addArrDef gfileSetsType $name "procedural"
  529.     if {[askyesno "I've added a template for the procedure to your 'prefs.tcl'. Do you want to edit it now?"] == "yes"} {
  530.         editPrefs
  531.         goto [maxPos]
  532.         beep
  533.         message "Make sure you 'load' the new procedure."
  534.     }
  535.     lappend filesetsNotInMenu $name
  536.     return $name
  537. }
  538.  
  539. proc fromDirectoryCreateFileset {} {
  540.     global gfileSets gfileSetsType    
  541.     
  542.     set name [getFilesetDirectoryAndPattern]
  543.     if ![string length $name] return
  544.     
  545.     set gfileSetsType($name) "fromDirectory"
  546.     
  547.     if {[askyesno "Save new fileset?"] == "yes"} {
  548.         addArrDef gfileSets $name $gfileSets($name)
  549.         addArrDef gfileSetsType $name "fromDirectory"
  550.     }
  551.     return $name
  552. }
  553.  
  554. proc getFilesetDirectoryAndPattern {} {
  555.     global gfileSets
  556.     set name [getline "New fileset name:" ""]
  557.     if {![string length $name]} return
  558.     
  559.     set dir [string trim [get_directory -p "New fileset dir:"] ":"]
  560.     if {![string length $dir]} return
  561.     
  562.     set filePat [getline "File pattern:" "*"]
  563.     if {![string length $filePat]} return
  564.     
  565.     set gfileSets($name) "$dir:$filePat"
  566.     return $name
  567. }
  568.  
  569. proc fromDirectoryFilesetUpdate {name} {
  570.     # done on the fly so no need to update
  571.     #global fileSets gfileSets
  572.     #set fileSets($name) [glob -nocomplain -t TEXT "$gfileSets($name)"]
  573. }
  574.  
  575. proc fromHierarchyCreateFileset {} {
  576.     global gfileSets gfileSetsType    
  577.     
  578.     set name [getFilesetDirectoryAndPattern]
  579.     if ![string length $name] return
  580.     
  581.     set gfileSetsType($name) "fromHierarchy"
  582.     set depth [listpick -p "Depth of hierarchy?" -L 3 {1 2 3 4 5 6 7}]
  583.     if { $depth == "" } {set depth 3}
  584.     
  585.     set gfileSets($name) [list $gfileSets($name) $depth]
  586.     
  587.     if {[askyesno "Save new fileset?"] == "yes"} {
  588.         addArrDef gfileSets $name $gfileSets($name)
  589.         addArrDef gfileSetsType $name "fromHierarchy"
  590.     }
  591.     return $name
  592. }
  593.  
  594. proc fromHierarchyFilesetUpdate {name} {
  595.     global fileSets gfileSets
  596.     set fileSets($name) [fromHierarchyListFilesInFileSet $name]
  597. }
  598.  
  599. proc fromHierarchyMakeFileSetAndMenu {name andMenu} {
  600.     global filesetTemp fileSets gfileSets
  601.     set dir [file dirname [lindex $gfileSets($name) 0]]
  602.     set patt [file tail [lindex $gfileSets($name) 0]]
  603.     set depth [lindex $gfileSets($name) 1]
  604.     # we make the menu as a string, but can bin it if we like
  605.     set menu [buildSubMenu [list $dir] $name filesetProc filesetTemp $patt $depth $name]
  606.     
  607.     # we need to construct the list of items
  608.     set fileSets($name) {}
  609.     foreach n [array names filesetTemp] {
  610.         lappend fileSets($name) $filesetTemp($n)
  611.     }
  612.     unset filesetTemp
  613.     return $menu
  614. }
  615.  
  616. proc fromHierarchyFilesetSelected {fset menu item} {
  617.     global gfileSets
  618.     set dir [file dirname [lindex $gfileSets($fset) 0]]
  619.     set ff [getFilesInSet $fset]
  620.     if { $fset == $menu } {
  621.         # it's top level
  622.         if {[set match [lsearch $ff ${dir}:$item]] >= 0} {
  623.             autoUpdateFileset $fset
  624.             generalOpenFile [lindex $ff $match]
  625.             return
  626.         }
  627.     }
  628.     # the following two are slightly cumbersome, but give us the best
  629.     # chance of finding the correct file given any ambiguity (which can
  630.     # certainly arise if file and directory names clash excessively).
  631.     if {[set match [lsearch $ff ${dir}:${menu}:$item]] >= 0} {
  632.         autoUpdateFileset $fset
  633.         generalOpenFile [lindex $ff $match]
  634.         return
  635.     }
  636.     if {[set match [lsearch $ff ${dir}:*:${menu}:$item]] >= 0} {
  637.         autoUpdateFileset $fset
  638.         generalOpenFile [lindex $ff $match]
  639.         return
  640.     }
  641.     alertnote "Weird! Couldn't find it."
  642. }
  643.  
  644.  
  645. proc codewarriorCreateTagFile {} { return [alphaCreateTagFile] }
  646. proc thinkCreateTagFile {} { return [alphaCreateTagFile] }
  647. proc codewarriorCreateFileset {} { return [createWarriorFileset] }
  648. proc thinkCreateFileset {} { return [createThinkFileset] }
  649.  
  650. proc fromOpenWindowsCreateFileset {} {
  651.     global gfileSets
  652.     
  653.     set name [prompt "Create fileset containing current windows under what name?" "OpenWins"]
  654.  
  655.     addArrDef gfileSets $name [winNames -f]
  656.     set gfileSets($name) [winNames -f]
  657.  
  658.     return $name
  659. }
  660.  
  661. ##################################
  662. #                                 #
  663. #    Section    4: Menu    Procedures     #
  664. #                                 #
  665. ##################################
  666.  
  667. ## 
  668.  # Global procedures to    deal with the fact that    Alpha can only have    one
  669.  # menu    with each given    name.  This    is only    a problem in dealing with
  670.  # user-defined    menus such as fileset menus, tex-package menus,    ...
  671.  ##
  672.  
  673. ## 
  674.  # -------------------------------------------------------------------------
  675.  #     
  676.  #    "makeFilesetSubMenu" --
  677.  #    
  678.  #     If    desired    this is    the    only procedure you need    use    ---    it returns
  679.  #     a menu    creation string, taking    account    of the unique name requirement
  680.  #     and will make sure    your procedure 'proc' is called    with the real
  681.  #     menu name!
  682.  # -------------------------------------------------------------------------
  683.  ##
  684. proc makeFilesetSubMenu {fset name proc args} {
  685.     if { [string length $proc] > 1 } {
  686.         return [concat {menu -n} [list [registerFilesetMenuName $fset $name $proc]] -p subMenuProc $args]
  687.     } else {
  688.         return [concat {menu -n} [list [registerFilesetMenuName $fset $name]] $args]
  689.     }
  690. }
  691.  
  692. ## 
  693.  # -------------------------------------------------------------------------
  694.  #     
  695.  #    "registerFilesetMenuName" --
  696.  #    
  697.  #     Call to ensure    unique fileset submenu names.  We just add spaces
  698.  #     as    appropriate    and    keep track of everything for you!  Filesets
  699.  #     which have    multiple menus _must_ register the main    menu first.
  700.  # -------------------------------------------------------------------------
  701.  ##
  702. proc registerFilesetMenuName {fset name {proc ""}} {
  703.     global subMenuInfo subMenuFilesetInfo
  704.     if { $fset == $name && [info exists subMenuFilesetInfo($fset)] } {
  705.         # if the fileset already has a base menu, use that:
  706.         foreach n $subMenuFilesetInfo($fset) {
  707.             if { [string trimright $n] == $fset } {
  708.                 set base $n
  709.             } 
  710.             unset subMenuInfo($n)
  711.         }
  712.         unset subMenuFilesetInfo($fset)
  713.     }
  714.     set original $name                    
  715.     if [info exists base] {
  716.         set name $base
  717.     } else {
  718.         # I add at least one space to _all_ hierarchical submenus now.
  719.         # This is so I won't clash with any current or future modes
  720.         # which should never normally add spaces themselves.
  721.         append name " "
  722.         while { [info exists subMenuInfo($name)] } {
  723.             append name " "
  724.         }        
  725.     }
  726.     
  727.     set subMenuInfo($name) [list "$fset" "$original" "$proc"]
  728.     # build list of a fileset's menus
  729.     lappend subMenuFilesetInfo($fset) "$name"
  730.     
  731.     return $name
  732. }
  733.  
  734.  
  735. proc realMenuName {name} {
  736.     global subMenuInfo
  737.     return [lindex $subMenuInfo($name) 1]
  738. }
  739.  
  740. ## 
  741.  # -------------------------------------------------------------------------
  742.  #     
  743.  #    "subMenuProc" --
  744.  #    
  745.  #     This procedure    is implicitly used to deal with    ensuring unique
  746.  #     sub-menu names.  It calls the procedure you asked for,    with
  747.  #     the name of the menu you think    you're using.
  748.  # -------------------------------------------------------------------------
  749.  ##
  750. proc subMenuProc {menu item} {
  751.     global subMenuInfo
  752.     set l $subMenuInfo($menu)
  753.     set realProc [lindex $l 2]
  754.     # try and call the proc with three arguments (fileset is 1st)
  755.     if [catch {$realProc [lindex $l 0] [lindex $l 1] "$item"}] {
  756.         $realProc [lindex $l 1] "$item"
  757.     }
  758. }
  759.  
  760.  
  761. proc filesetMenuProc {menu item} {
  762.     global HOME
  763.     switch $item {
  764.         "Edit File" {
  765.         editFile
  766.         return
  767.         } 
  768.     "Help" {
  769.         editMark "$HOME:Help:Manual" "File Sets" -r
  770.         return
  771.         }
  772.     "New Fileset" {
  773.         return [newFileset]
  774.         }
  775.     "Delete Fileset" {
  776.         return [deleteFileset]
  777.         }
  778.     }
  779.  
  780. }
  781.  
  782. ## 
  783.  # -------------------------------------------------------------------------
  784.  #     
  785.  #    "filesetProc" --
  786.  #    
  787.  #     Must be called    by 'subMenuProc'
  788.  # -------------------------------------------------------------------------
  789.  ##
  790. proc filesetProc {fset menu item} {
  791.     global gfileSetsType 
  792.     if {$fset != ""} {set m $fset} else { set m $menu}
  793.     switch $gfileSetsType($m) {
  794.         "fromDirectory" -
  795.         "think" -
  796.         "codewarrior" -
  797.         "fromOpenWindows" {
  798.             filesetBasicOpen $m $item
  799.         }
  800.         "ftp" { ftpFilesetOpen $m $item }
  801.         "default" {
  802.             # try a type-specific method first
  803.             if [catch {eval $gfileSetsType($m)FilesetSelected \{$fset\} \{$menu\} \{$item\}}] {
  804.                 # if that failed then perhaps it only wants two parameters
  805.                 if [catch {eval $gfileSetsType($m)FilesetSelected \{$menu\} \{$item\}}] {
  806.                     # if that failed then just hope it's an ordinary list
  807.                     filesetBasicOpen $m $item
  808.                 }
  809.             }
  810.         }
  811.     }
  812.     
  813. }
  814.  
  815. proc filesetBasicOpen { menu item } {
  816.     if {[set match [lsearch [getFilesInSet $menu] *:$item]] >= 0} {
  817.         autoUpdateFileset $menu
  818.         generalOpenFile [lindex [getFilesInSet $menu] $match]
  819.     }
  820. }
  821.  
  822. proc generalOpenFile {file} {
  823.     getFileInfo $file a
  824.     if {$a(type) == "TEXT"} {
  825.         edit $file
  826.     } else {
  827.         sendOpenEvent -noreply Finder "${file}"
  828.     }
  829. }
  830.  
  831. proc registerUpdateProcedure { type proc } {
  832.     global filesetUpdateProcs
  833.     lappend filesetUpdateProcs($type) [list $proc]
  834. }
  835.  
  836. proc filesetUtilsProc { menu item } {
  837.     global filesetUtils gfileSetsType currFileSet filesetFlags filesetFlagsRebuild
  838.     if [info exists filesetUtils($item)] {
  839.         # it's a utility
  840.         set utilDesc $filesetUtils($item)
  841.         set allowedTypes [lindex $utilDesc 0]
  842.         if [string match $allowedTypes $gfileSetsType($currFileSet)] {
  843.             return [eval [lindex $utilDesc 1]]
  844.         } else {
  845.             beep
  846.             message "That utility can't be applied to the current file-set."
  847.             return
  848.         }
  849.     } elseif [info exists filesetFlags($item)] {
  850.         # it's a flag
  851.         
  852.         if [set    filesetFlags($item)    [expr 1    - $filesetFlags($item)]] {
  853.             markMenuItem "filesetFlags" $item on
  854.         } else {
  855.             markMenuItem "filesetFlags" $item off
  856.         }     
  857.          addArrDef filesetFlags "$item" "$filesetFlags($item)"
  858.         if [info exists filesetFlagsRebuild($item)] {
  859.             rebuildSomeFilesetMenu $filesetFlagsRebuild($item)
  860.         }
  861.         
  862.         return
  863.     } else {
  864.         $item
  865.     }
  866. }
  867.  
  868. proc getFilesInSet {fset} {
  869.     global gfileSets fileSetsTypesThing gfileSetsType
  870.     switch $fileSetsTypesThing($gfileSetsType($fset)) {
  871.         "list" {
  872.             return $gfileSets($fset)
  873.         }
  874.         "glob" {
  875.             global filesetFlags
  876.             if $filesetFlags(includeNonTextFiles) {
  877.                 return [glob -nocomplain "$gfileSets($fset)"]
  878.             } else {
  879.                 return [glob -nocomplain -t TEXT "$gfileSets($fset)"]
  880.             }
  881.         }
  882.         "procedural" {
  883.             return [$gfileSets($fset)]
  884.         }        
  885.         "default" {
  886.             global fileSets
  887.             return $fileSets($fset)
  888.         }
  889.     }
  890. }
  891.  
  892. proc makeFileSetAndMenu { name andMenu } {
  893.     global gfileSetsType fileSetsTypesThing
  894.     message "Building ${name}..."
  895.     set type $gfileSetsType($name)
  896.     switch $fileSetsTypesThing($type) {
  897.         "list" -
  898.         "glob" {
  899.             if $andMenu {
  900.                 set menu {}
  901.                 foreach m [getFilesInSet $name] {
  902.                     lappend menu "[file tail $m]\&"
  903.                 }
  904.                 return [makeFilesetSubMenu $name $name filesetProc -s -m [lsort -i $menu]]
  905.             } else {
  906.                 return
  907.             }
  908.         }
  909.         "procedural" {
  910.             return
  911.         }
  912.         "default" {
  913.             return [${type}MakeFileSetAndMenu $name $andMenu]
  914.         }
  915.     }     
  916. }
  917.  
  918. proc filesetsSorted { order usedvar } {
  919.     upvar $usedvar used
  920.     global filesetFlags gfileSets gfileSetsType
  921.     set sets {}
  922.     foreach item $order {
  923.         switch -- [lindex $item 0] {
  924.           "-" { 
  925.               # add divider
  926.             lappend sets "(-" 
  927.             continue
  928.           } 
  929.           "*" {
  930.             # add all the rest
  931.               set subset {}
  932.             foreach s [array names gfileSets] {
  933.                 if ![listContains $used $s]  {
  934.                     lappend subset $s
  935.                     lappend used $s
  936.                 }
  937.             }
  938.             foreach f [lsort $subset] {
  939.                 lappend sets [makeFileSetAndMenu $f 1]
  940.             }
  941.           } 
  942.           "pattern" {
  943.               # find all which match a given pattern
  944.               set patt [lindex $item 1]
  945.               set subset {}
  946.             foreach s [array names gfileSets] {
  947.                 if ![listContains $used $s]  {
  948.                     if [string match $patt $s] {
  949.                         lappend subset $s
  950.                         lappend used $s
  951.                     }
  952.                 }
  953.             }
  954.             foreach f [lsort $subset] {
  955.                 lappend sets [makeFileSetAndMenu $f 1]
  956.             }
  957.               
  958.           }
  959.           "submenu" {
  960.               # add a submenu with name following and sub-order
  961.               set name [lindex $item 1]
  962.             set suborder [lrange $item 2 end]              
  963.               # we make kind of a pretend fileset here.
  964.               set subsets [filesetsSorted $suborder used]
  965.               if { $subsets != "" } {
  966.                   lappend sets [makeFilesetSubMenu $name $name filesetProc -m $subsets]
  967.               }
  968.           }
  969.           "default" {        
  970.             set subset {} 
  971.             foreach s [array names gfileSets] {
  972.                 if {[listContains $item $gfileSetsType($s)] && ![listContains $used $s]}  {
  973.                     lappend subset $s
  974.                     lappend used $s
  975.                 }
  976.             }
  977.             foreach f [lsort $subset] {
  978.                 lappend sets [makeFileSetAndMenu $f 1]
  979.             }
  980.           }
  981.         }
  982.     
  983.     }
  984.     # remove multiple and leading, trailing '-' in case there were gaps
  985.     regsub -all {\(-( \(-)+} $sets {(-} sets
  986.     while { [lindex $sets 0] == "(-" } { set sets [lrange $sets 1 end] }
  987.     set l [expr [llength $sets] -1]
  988.     if { [lindex $sets $l] == "(-" } { set sets [lrange $sets 0 [incr l -1]] }
  989.     
  990.     return $sets
  991. }
  992.  
  993.  
  994. # This should be used by "AlphaBits.tcl" for the initial build.
  995. # After that it is only necessary to call 'rebuildAllFilesets'.
  996. # Currently this proc is only necessary for backwards compatibility
  997. # It should be removed at some future date.
  998. proc rebuildFilesetMenu {} { 
  999.     global gfileSets gfileSetsType
  1000.     foreach fset [array names gfileSets] {
  1001.         if ![info exists gfileSetsType($fset)] { 
  1002.             addArrDef gfileSetsType "$fset" "fromDirectory"
  1003.             set gfileSetsType($fset) "fromDirectory" 
  1004.         }        
  1005.     }
  1006.     
  1007.     rebuildAllFilesets 
  1008. }
  1009.  
  1010. ## 
  1011.  # -------------------------------------------------------------------------
  1012.  #     
  1013.  #    "zapAndBuildFilesets" --
  1014.  #    
  1015.  #     This does a complete rebuild of all information.  The problem is that
  1016.  #     the names of menus    may    actually change    (spaces    added/deleted).    This
  1017.  #     is    not    a problem for the fileset menu,    but    is a problem for any
  1018.  #     filesets which    have been added    to other menus,    since they won't know
  1019.  #     that they need    to be rebuilt.
  1020.  # -------------------------------------------------------------------------
  1021.  ##
  1022. proc zapAndBuildFilesets {} {
  1023.     global subMenuInfo subMenuFilesetInfo
  1024.     unset subMenuInfo
  1025.     unset subMenuFilesetInfo
  1026.     rebuildAllFilesets
  1027. }
  1028.  
  1029. proc rebuildAllFilesets {} {
  1030.     global gfileSets fsetMenuName  filesetSortOrder 
  1031.     global filesetFlags filesetsNotInMenu
  1032.     
  1033.     if $filesetFlags(sortFilesetsByType) {
  1034.         # just make file-sets for those we don't want in the menu
  1035.         foreach f $filesetsNotInMenu {
  1036.             makeFileSetAndMenu $f 0
  1037.         }
  1038.         
  1039.         set used $filesetsNotInMenu
  1040.         set sets [filesetsSorted $filesetSortOrder used]
  1041.     } else {
  1042.         foreach f [lsort [array names gfileSets]] {
  1043.             set doMenu [expr ![listContains $filesetsNotInMenu $f]]
  1044.             set menu [makeFileSetAndMenu $f $doMenu]
  1045.             if { $doMenu && $menu != "" } {
  1046.                 lappend sets $menu
  1047.             }        
  1048.         }            
  1049.     }
  1050.     
  1051.     regsub -all {[-][nm]} $sets "" names
  1052.     set names [map cadr $names]
  1053.     set names [map "string trimright" $names]
  1054.  
  1055.     menu -m -n $fsetMenuName -p filesetMenuProc \
  1056.         [concat {{/'Edit File…} {menu -n Utilities {}}} "Help" \
  1057.         "(-" $sets]    
  1058.     rebuildFilesetUtilsMenu
  1059.     callFilesetUpdateProcedures
  1060.     
  1061.     message ""
  1062. }
  1063.  
  1064.  
  1065. ## 
  1066.  # -------------------------------------------------------------------------
  1067.  #     
  1068.  #    "rebuildSomeFilesetMenu" --
  1069.  #    
  1070.  #     If    given '*' rebuild the entire menu, else    rebuild    only those types
  1071.  #     given.     This is generally useful to avoid excessive rebuilding    when
  1072.  #     flags are adjusted
  1073.  # -------------------------------------------------------------------------
  1074.  ##
  1075. proc rebuildSomeFilesetMenu {amount} {
  1076.     global gfileSets gfileSetsType
  1077.     switch -- $amount {
  1078.         "*" {
  1079.             rebuildAllFilesets
  1080.         }
  1081.         "default" {
  1082.             foreach f [lsort [array names gfileSets]] {
  1083.                 if {$f == "Help"} continue
  1084.                 if [listContains $amount $gfileSetsType($f)] {
  1085.                     eval [makeFileSetAndMenu $f 1]
  1086.                 }
  1087.             
  1088.             }            
  1089.         }
  1090.     }
  1091.         
  1092. }
  1093.  
  1094. proc rebuildFilesetUtilsMenu {} {
  1095.     global gfileSets  currFileSet fileSetsTypesThing filesetUtils filesetFlags
  1096.  
  1097.     menu -n "Utilities" -p filesetUtilsProc [concat \
  1098.         "newFileset…" \
  1099.         "deleteFileset…" \
  1100.         "updateCurrentFileset" \
  1101.         "<S<EzapAndBuildFilesets" \
  1102.         "<SrebuildAllFilesets" \
  1103.         \{[list menu -n choose -m -p changeFileSet [lsort [array names gfileSets]]]\} \
  1104.         \{[list menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]]\} \
  1105.         \{[list menu -n filesetFlags -p filesetUtilsProc [lsort [array names filesetFlags]]]\} \
  1106.         "(-" \
  1107.         "/T<I<OfindTag" \
  1108.         "createTagFile" \
  1109.         "(-" \
  1110.         [lsort [array names filesetUtils]] \
  1111.         ]
  1112.    
  1113.     filesetUtilsMarksTicks
  1114. }
  1115.  
  1116. proc rebuildSimpleFilesetMenus {} {
  1117.     global gfileSets fileSetsTypesThing
  1118.     menu -n choose -m -p changeFileSet [lsort [array names gfileSets]]
  1119.     menu -n createFileset -p createFileset [array names fileSetsTypesThing]
  1120.     menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]
  1121.     filesetUtilsMarksTicks
  1122. }
  1123.  
  1124. proc hideShowFileset { menu item } {
  1125.     global filesetsNotInMenu fsetMenuName
  1126.     if [listContains $filesetsNotInMenu $item] {
  1127.         global gfileSetsType
  1128.         if {$gfileSetsType($item) == "procedural"} {
  1129.             alertnote "Sorry, procedural filesets are completely dynamic and cannot appear in menus."
  1130.             return
  1131.         }
  1132.         set idx [lsearch $filesetsNotInMenu $item]
  1133.         set filesetsNotInMenu [lreplace $filesetsNotInMenu $idx $idx]        
  1134.         markMenuItem -m hideFileset $item off
  1135.         # would be better if we could just insert it
  1136.         rebuildAllFilesets
  1137.     } else {
  1138.         lappend filesetsNotInMenu $item
  1139.         markMenuItem -m hideFileset $item on 
  1140.         removeMenu $item
  1141.         if [catch { deleteMenuItem -m $fsetMenuName $item }] {
  1142.             # it's on a submenu and I can't be bothered to write
  1143.             # code to find that submenu name right now.
  1144.             rebuildAllFilesets
  1145.         }
  1146.     }
  1147.     global modifiedVars
  1148.     lappend modifiedVars filesetsNotInMenu
  1149. }
  1150.  
  1151. proc filesetUtilsMarksTicks {} {
  1152.     global currFileSet filesetFlags filesetsNotInMenu
  1153.     markMenuItem -m choose $currFileSet on
  1154.     
  1155.     foreach flag [array names filesetFlags] {
  1156.         if $filesetFlags($flag) {
  1157.             markMenuItem "filesetFlags" $flag on
  1158.         } else {
  1159.             markMenuItem "filesetFlags" $flag off
  1160.         }     
  1161.     }
  1162.     
  1163.     foreach name $filesetsNotInMenu {
  1164.         markMenuItem -m hideFileset $name on
  1165.     }
  1166.     
  1167. }
  1168.  
  1169.  
  1170. # Called in response to user changing filesets from the fileset menu.
  1171. proc changeFileSet {menu item} {
  1172.     global currFileSet tagFile
  1173.     
  1174.     markMenuItem -m choose $currFileSet off
  1175.     set currFileSet $item
  1176.     markMenuItem -m choose $currFileSet on
  1177.  
  1178.     # Bring in the tags file for this fileset
  1179.     set fname [tagFileName]
  1180.     if {[file exists $fname]} {
  1181.         if {[askyesno "Use tag file from folder \"$dir\" ?"] == "yes"} {
  1182.             set tagFile $fname
  1183.         }
  1184.     }
  1185. }
  1186.  
  1187. proc autoUpdateFileset { name } {
  1188.     global currFileSet filesetFlags
  1189.     if $filesetFlags(autoAdjustFileset) {
  1190.         set currFileSet $name
  1191.     }
  1192. }
  1193.  
  1194. #############################################
  1195. #                                            #
  1196. #    Section    5: General Utility procedures    #
  1197. #                                            #
  1198. #############################################
  1199.  
  1200. proc isWindowInFileset { {win "" } {type ""} } {
  1201.     if {$win == ""} { set win [lindex [winNames -f] 0] }
  1202.     global currFileSet gfileSets gfileSetsType
  1203.  
  1204.     if { $type == "" } {
  1205.         set okSets [array names gfileSets]
  1206.     } else {
  1207.         set okSets {}
  1208.         foreach s [array names gfileSets] {
  1209.             if { $gfileSetsType($s) == $type } {
  1210.                 lappend okSets $s
  1211.             }
  1212.         }
  1213.     }
  1214.     
  1215.     if [array exists gfileSets] {
  1216.         if {[lsearch -exact $okSets $currFileSet] != -1 } {
  1217.             # check current fileset
  1218.             if {[lsearch -exact [getFilesInSet $currFileSet] $win] != -1 } {
  1219.                 # we're set, it's in this fileset
  1220.                 return  $currFileSet
  1221.             }
  1222.         }
  1223.         
  1224.         # check other fileset
  1225.         foreach fset $okSets {
  1226.             if {[lsearch -exact [getFilesInSet $fset] $win] != -1 } {
  1227.                 # we're set, it's in this project
  1228.                 return  $fset
  1229.             }
  1230.         }   
  1231.     }
  1232.     return ""
  1233.     
  1234. }
  1235.  
  1236.  
  1237.  
  1238. ## 
  1239.  # -------------------------------------------------------------------------
  1240.  #     
  1241.  #    "iterateFileset" --
  1242.  # 
  1243.  #       Utility procedure to    iterate    over all files in a    project,
  1244.  #       calling some    predefined function    '$fn' for each member of
  1245.  #       project '$proj'.    The    results    of such    a call are passed to
  1246.  #       '$resfn'    if given. Finally "done" is    passed to 'resfn'.
  1247.  #     
  1248.  # -------------------------------------------------------------------------
  1249.  ##
  1250. proc iterateFileset { proj fn { resfn \# } } {
  1251.     global gfileSets gfileSetsType
  1252.     eval $resfn "first"
  1253.  
  1254.     set check [expr ![catch {$gfileSetsType($proj)IterateCheck check}]]
  1255.     
  1256.     foreach ff [getFileSet $proj] {
  1257.         if { $check && [$gfileSetsType($proj)IterateCheck $proj $ff] } {
  1258.             continue
  1259.         }
  1260.         set res [eval $fn \{$ff\}]
  1261.         eval $resfn \{$res\}
  1262.         
  1263.     }
  1264.     
  1265.     if $check {
  1266.         catch {$gfileSetsType($proj)IterateCheck done}
  1267.     }
  1268.     
  1269.     eval $resfn "done"
  1270.  
  1271. }
  1272.  
  1273. ########################
  1274. #                       #
  1275. #    Section    6:    Tags   #
  1276. #                       #
  1277. ########################
  1278.  
  1279. if ![string length [info commands alphaFindTag]] {
  1280.     rename findTag alphaFindTag
  1281.     rename createTagFile alphaCreateTagFile
  1282. }
  1283.  
  1284. proc tagFileName {} {
  1285.     global gfileSets currFileSet 
  1286.     return [file dirname [car $gfileSets($currFileSet)]]:[join ${currFileSet}]TAGS
  1287. }
  1288.  
  1289. proc findTag {} {
  1290.     global gfileSetsType currFileSet
  1291.     # try a type-specific method first
  1292.     if [catch {$gfileSetsType($currFileSet)FindTag}] {
  1293.         alphaFindTag
  1294.     }
  1295. }
  1296.  
  1297. proc createTagFile {} {
  1298.     global gfileSetsType currFileSet tagFile modifiedVars
  1299.     set tagFile [tagFileName]
  1300.     lappend modifiedVars tagFile
  1301.  
  1302.     # try a type-specific method first
  1303.     if [catch {$gfileSetsType($currFileSet)CreateTagFile}] {
  1304.         alphaCreateTagFile
  1305.     }
  1306. }
  1307.  
  1308.  
  1309. ############################
  1310. #                           #
  1311. #        Section    7: Utils   #
  1312. #                           #
  1313. ############################
  1314.     
  1315.     
  1316. proc dirtyFileset { fset } {
  1317.     foreach f [getFilesInSet $fset] {
  1318.         if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { return 1 }
  1319.     }
  1320.     return 0
  1321. }
  1322.  
  1323. proc saveEntireFileset { fset } {
  1324.     foreach f [getFilesInSet $fset] {
  1325.         if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { 
  1326.             bringToFront $f
  1327.             save 
  1328.         }
  1329.     }
  1330. }
  1331.  
  1332. proc closeEntireFileset { {fset ""} } {
  1333.     set fset [pickFileset $fset "Close which fileset?" "popup"]
  1334.         
  1335.     foreach f [getFilesInSet $fset] {
  1336.         if ![catch {getWinInfo -w $f arr}] {
  1337.             bringToFront $f
  1338.             killWindow
  1339.         }
  1340.     }
  1341. }
  1342.  
  1343. proc fileToAlpha {f} {
  1344.     if {[file isfile $f] && ([getFileType $f] == "TEXT") && ([getFileSig $f] != "ALFA")} {
  1345.         message "Converting $f"
  1346.         setFileInfo $f creator ALFA
  1347.     }    
  1348. }
  1349.  
  1350. proc filesetToAlpha {} {
  1351.     set fset [pickFileset "" {Convert all files from which fileset?} "popup"]
  1352.     iterateFileset $fset fileToAlpha
  1353. }
  1354.  
  1355. ## 
  1356.  # -------------------------------------------------------------------------
  1357.  # 
  1358.  # "replaceInFileset" --
  1359.  # 
  1360.  #  Quotes things correctly so searches work, and adds a check on
  1361.  #  whether there are any windows.
  1362.  # -------------------------------------------------------------------------
  1363.  ##
  1364. proc replaceInFileset {} {
  1365.     global gfileSets
  1366.  
  1367.     set from [prompt "Search string:" [searchString]]
  1368.     searchString $from
  1369.     set from [quoteExpr $from]
  1370.     regsub -all {&} $from {\\&} from
  1371.     regsub -all {\^} $from {\\^} from
  1372.     regsub -all {\$} $from {\\$} from
  1373.     regsub -all {\?} $from {\\?} from
  1374.     set to [prompt "Replace string:" [replaceString]]
  1375.     replaceString $to
  1376.     regsub -all {&} $to {\\&} to
  1377.     set fsets [pickFileset "" "Which filesets?" "multilist"]
  1378.  
  1379.     if {[winNames] != ""} {
  1380.         if {[buttonAlert "Save all windows?" "Yes" "Cancel"] != "Yes"} return
  1381.         saveAll
  1382.     }
  1383.  
  1384.     set cid [scancontext create]
  1385.     scanmatch $cid $from {
  1386.         set matches($f) 1
  1387.     }
  1388.     foreach fset $fsets {
  1389.         foreach f [getFileSet $fset] {
  1390.             if {![catch {set fid [open $f]}]} {
  1391.                 message "Looking at '[file tail $f]'"
  1392.                 scanfile $cid $fid
  1393.                 close $fid
  1394.             }
  1395.         }
  1396.     }
  1397.     
  1398.     scancontext delete $cid
  1399.     
  1400.     foreach f [array names matches] {
  1401.         message "Modifying ${f}…"
  1402.         set cid [open $f "r"]
  1403.         if {[regsub -all $from [read $cid] $to out]} {
  1404.             set ocid [open $f "w+"]
  1405.             puts -nonewline $ocid $out
  1406.             close $ocid
  1407.         }
  1408.         close $cid
  1409.     }
  1410.     
  1411.     if {[winNames] != ""} {
  1412.         if {[buttonAlert "Revert affected windows?" "Yes" "No"] == "Yes"} {
  1413.             foreach f [array names matches] {
  1414.                 foreach w [winNames -f] {
  1415.                     set ww $w
  1416.                     regexp {(.*) <[0-9]+>} $w dummy w
  1417.                     if {$f == $w} {
  1418.                         bringToFront $ww
  1419.                         revert
  1420.                     }
  1421.                 }        
  1422.             }
  1423.         }
  1424.     }
  1425.     message ""
  1426. }
  1427.  
  1428. proc openEntireFileset {} {
  1429.     set fset [pickFileset "" "Open which fileset?" "popup"]
  1430.     
  1431.     # we use our iterator in case there's something special to do
  1432.     iterateFileset $fset "edit -c -w"
  1433. }
  1434.  
  1435. proc openFilesetFolder {} {
  1436.     global gfileSets
  1437.     set fset [pickFileset "" "Open which fileset's folder?" "popup"]
  1438.     titlebar [file dirname $gfileSets($fset)]
  1439. }
  1440.  
  1441. proc stuffFileset {} {
  1442.     global gfileSetsType gfileSets
  1443.     set fset [pickFileset "" "Which fileset shall I stuff?" "popup"]
  1444.     if [string length $fset] {
  1445.         if { $gfileSetsType($fset) == "fromDirectory" && \
  1446.              [askyesno "Stuff entire directory?"] == "yes" } {
  1447.              launchForeAppl DStf
  1448.              sendOpenEvent reply 'DStf' "[file dirname $gfileSets($fset)]:"
  1449.         } else {            
  1450.             launchForeAppl DStf
  1451.             eval sendOpenEvents 'DStf' [getFilesInSet $fset]
  1452.         }        
  1453.         sendQuitEvent 'DStf'
  1454.     }
  1455. }
  1456.  
  1457. proc filesetRememberOpenClose { file } {
  1458.     global fileset_openorclosed
  1459.     set fileset_openorclosed [list "$file" [lsearch -exact [winNames -f] $file]]
  1460. }
  1461.  
  1462. proc filesetRevertOpenClose { file } {
  1463.     global fileset_openorclosed
  1464.     if { [lindex $fileset_openorclosed 0] == "$file" } {
  1465.         if { [lindex $fileset_openorclosed 1] < 0 } {
  1466.             killWindow
  1467.         }
  1468.     }    
  1469.     catch {unset fileset_openorclosed}
  1470. }
  1471.  
  1472. proc wordCountFileset {} {
  1473.   global currFileSet
  1474.   iterateFileset $currFileSet wordCountProc filesetUtilWordCount
  1475. }
  1476.  
  1477. proc wordCountFilesetFast {} {
  1478.   global currFileSet
  1479.   iterateFileset $currFileSet wc filesetUtilWordCount
  1480. }
  1481.  
  1482. proc filesetUtilWordCount { count } {
  1483.     global fs_ccount fs_wcount fs_lcount
  1484.     switch $count {
  1485.         "first" {
  1486.             set fs_ccount 0
  1487.             set fs_wcount 0
  1488.             set fs_lcount 0
  1489.         }       
  1490.         "done" {
  1491.             alertnote "There were $fs_ccount lines, $fs_wcount words and $fs_ccount chars"
  1492.             unset fs_ccount fs_wcount fs_lcount
  1493.         }
  1494.         default {
  1495.             incr fs_ccount [lindex $count 2]
  1496.             incr fs_wcount [lindex $count 1]
  1497.             incr fs_lcount [lindex $count 0]
  1498.         }
  1499.     }
  1500. }
  1501.  
  1502.  
  1503.  
  1504. ##
  1505.  # ----------------------------------------------------------------------
  1506.  #
  1507.  #  "wordCountProc" --
  1508.  #
  1509.  #   We use this proc to count words.  Calling 'wc' would be quicker (it is a 
  1510.  #   C procedure and doesn't require the opening of a file), however it seems 
  1511.  #   to have a HUGE memory leak so is a bit useless for our purposes.
  1512.  #
  1513.  # ----------------------------------------------------------------------
  1514.  ##
  1515. proc wordCountProc { file } {
  1516.     filesetRememberOpenClose "$file"
  1517.     openFileQuietly "$file"
  1518.     set chars [maxPos]
  1519.     set lines [lindex [posToRowCol $chars] 0]
  1520.     set text [getText 0 [maxPos]]
  1521.     regsub -all {[!=;.,\(\#\=\):\{\"\}]} $text " " ret
  1522.     set words [llength $ret]
  1523.     unset text ret
  1524.     filesetRevertOpenClose $file
  1525.     return "$chars $words $lines"
  1526. }
  1527.  
  1528.  
  1529.  
  1530.  
  1531. # Should be last so all filesets make it in.
  1532. message "Building filesets..."
  1533.  
  1534. rebuildFilesetMenu
  1535.  
  1536.  
  1537.  
  1538.